Pascal Super Library/Pascal Super Library (CW International)(1997).bin/DELPHI32/GRIDS/STRGRDEX/STRGRDEX.PAS

Pascal/Delphi Source File | 1996-10-22 | 9KB | 308 lines

unit strgrdex;

// Written By Tom Lee , Taiwan , Republic of China
// Ver 1.02 Last modify Date OCT 22 1996
// Freeware Component For Delphi 2.0x
// E-Mail : [e-mail]
// Home Page : http://www.aaa.hinet.net/delphi


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids;

type
  TStringGridEx = class(TStringGrid)
  private
    { Private declarations }
    FCTL3D:boolean;
    FLastRow:integer;
    FMouseDownRow:integer;
    FMultiSelect:Boolean;
    FOriginRowCount:integer;
    FSelectedColor:TColor;
    FSelectedTextColor:TColor;
    FSelectRows:TStrings;
    procedure DeSelectAll;
    procedure SetCTL3D(value:Boolean);
    procedure SetMultiSelect(value:Boolean);
    procedure SetSelectedColor(value:TColor);
    procedure SetSelectedTextColor(value:TColor);
  protected
    { Protected declarations }
     procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetSelectRow(RowValue:integer):Boolean;
    function GetSelectRowCount:integer;
    procedure SetSelectRow(RowValue:integer;Selected:Boolean);
  published
    { Published declarations }
    property CTL3D : boolean read FCTL3D write SetCTL3D default false;
    property SelectedColor:TColor read FSelectedColor write SetSelectedColor default clHighLight;
    property SelectedTextColor:TColor read FSelectedTextColor write SetSelectedTextColor default clHighLightText;
    property MultiSelect :Boolean read FMultiSelect write SetMultiSelect default false;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TStringGridEx]);
end;

constructor TStringGridEx.Create(AOwner: TComponent);
var
   idx:integer;
begin
     inherited Create(AOwner);
     options:=[goDrawFocusSelected,goFixedVertLine,goFixedHorzLine,goVertLine,goHorzLine,goRowSelect];
     FMultiSelect:=False;
     FOriginRowCount:=RowCount;
     FSelectRows:=TStringList.Create;
     for idx:=0 to RowCount - 1 do FSelectRows.Add('N');
     FSelectedColor:=clHighLight;
     FSelectedTextColor:=clHighLightText;
     FLastRow:=FixedRows;
     FSelectRows[FLastRow]:='Y';
     FCtl3D:=False;
end;

destructor TStringGridEx.Destroy;
begin
     FSelectRows.Free;
     inherited Destroy;
end;

procedure TStringGridEx.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
   idx:integer;
begin
     if FOriginRowCount>RowCount then
     begin
          FSelectRows.Clear;
          for idx:=0 to RowCount - 1 do FSelectRows.Add('N');
          FOriginRowCount:=RowCount;
     end;

     if FOriginRowCount<RowCount then
     begin
          for idx:=FOriginRowCount to RowCount - 1 do FSelectRows.Add('N');
          FOriginRowCount:=RowCount;
     end;

     if (FSelectRows[ARow]='Y') and (ACol >= FixedCols) and (ARow >= FixedRows) then
     begin
          Canvas.Font.Color:=FSelectedTextColor;
          Canvas.Brush.color:=FSelectedColor;
          Canvas.FillRect(ARect);
     end;

     inherited DrawCell(ACol, ARow, ARect, AState);

     if (FCTL3D=True) and ([goVertLine,goHorzLine] * Options = [goVertLine,goHorzLine]) then
     with ARect do
     begin
          Canvas.Pen.Color := clHighLightText;
          Canvas.PolyLine([Point(Left, Bottom - 1), Point(Left, Top), Point(Right, Top)]);
     end;

end;

procedure TStringGridEx.SetSelectedColor(value:TColor);
begin
     if value <> FSelectedColor then
     begin
          FSelectedColor:=value;
          invalidate;
     end;
end;

procedure TStringGridEx.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
   Arow,Acol : longint;
begin
     if FMultiSelect then
     begin
          MouseToCell(x,y,Acol,Arow);
          FMouseDownRow:=Arow;
     end;
     inherited MouseDown(Button,Shift,X,Y);
end;

procedure TStringGridEx.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
     Arow,Acol : longint;
     idx : integer;
begin
     MouseToCell(x,y,Acol,Arow);
     if Arow<0 then Arow:=RowCount-1;

     if FMultiSelect then
     begin // Multi-Select

          if Shift=[] then
          begin
               DeSelectAll;
               if FMouseDownRow=ARow then
               begin
                    FSelectRows[ARow]:='Y';
                    FLastRow:=ARow;
               end
               else
               begin
                    if ARow>FMouseDownRow then
                        for Idx:= FMouseDownRow to ARow do FSelectRows[idx]:='Y'
                    else
                        for Idx:= FMouseDownRow downto ARow do FSelectRows[idx]:='Y';
               end;
          end;

          if  Shift=[ssShift] then
          begin
               DeSelectAll;
               if ARow>FLastRow then
                   for Idx:= FLastRow to ARow do FSelectRows[idx]:='Y'
               else
                   for Idx:= FLastRow downto ARow do FSelectRows[idx]:='Y';
          end;

          if Shift=[ssCtrl] then
          begin
               if FSelectRows[ARow]='Y' then
               begin
                    FSelectRows[ARow]:='N';
                    Invalidate;
               end
               else
               begin
                    FLastRow:=ARow;
                    FSelectRows[ARow]:='Y';
               end;
          end;
     end
     else // Single Select
     begin
          FSelectRows[FLastRow]:='N';
          FSelectRows[ARow]:='Y';
          FLastRow:=ARow;
     end;

     Invalidate;
     inherited MouseUp(Button,Shift,X,Y);
end;

procedure TStringGridEx.KeyUp(var Key: Word; Shift: TShiftState);
var
   Idx:integer;
begin
     if Shift = [] then
     begin
          if (Key=VK_HOME) or(Key=VK_END) or (Key=VK_PRIOR) or (Key=VK_NEXT)
          or(Key=VK_UP) or (Key=VK_DOWN) or (Key=VK_LEFT) or (Key=VK_RIGHT)then
          begin
               DeSelectAll;
               FSelectRows[Row]:='Y';
               FLastRow:=Row;
               Invalidate;
          end;
     end;

     if FMultiSelect then
     begin
          if Shift = [ssShift] then
          begin
               if (Key=VK_HOME) or(Key=VK_END) or (Key=VK_PRIOR) or (Key=VK_NEXT)
               or(Key=VK_UP) or (Key=VK_DOWN) or (Key=VK_LEFT) or (Key=VK_RIGHT)then
               begin
                    if Row>FLastRow then
                        for Idx:= FLastRow to Row do FSelectRows[idx]:='Y'
                    else
                        for Idx:= FLastRow downto Row do FSelectRows[idx]:='Y';

                    FLastRow:=Row;
                    Invalidate;
               end;
          end;
     end;

     inherited KeyUp(Key,Shift);
end;

function TStringGridEx.GetSelectRow(RowValue:integer):Boolean;
var
   ret:Boolean;
begin
     if FSelectRows[RowValue]='Y' then
         ret:=True
     else
         ret:=False;

     result:=ret;
end;

procedure TStringGridEx.SetSelectRow(RowValue:integer;Selected:Boolean);
begin
     if Selected then
        FSelectRows[RowValue]:='Y'
     else
        FSelectRows[RowValue]:='N';

     Invalidate;
end;

procedure TStringGridEx.DeSelectAll;
var
   idx:integer;
begin
     for idx:=0 to FSelectRows.Count-1 do
         FSelectRows[idx]:='N';
end;

procedure TStringGridEx.SetMultiSelect(value:Boolean);
begin
     if value<>FMultiSelect then
     begin
          FMultiSelect:=value;
     end;
end;

function TStringGridEx.GetSelectRowCount:integer;
var
   idx,cnt:integer;
begin
     cnt:=0;
     for idx:=0 to FSelectRows.Count-1 do
      if FSelectRows[idx]='Y' then inc(Cnt);
     result:=cnt;
end;

procedure TStringGridEx.SetSelectedTextColor(value:TColor);
begin
     if value <> FSelectedTextColor then
     begin
          FSelectedTextColor:=value;
          invalidate;
     end;
end;

procedure TStringGridEx.SetCtl3D(value:Boolean);
begin
     if FCTL3D<>Value then
     begin
          FCTL3D:=Value;
          Invalidate;
     end;
end;

end.